BMUG PD-ROM 1995 Fall/PD-ROM F95.toast/Utilities/System Utils/G-R System Utils/PRAM-Reader 1.1.2 ƒ/PRAM-Reader.p

Text File | 1995-03-14 | 13.2 KB | 618 lines | [TEXT/PJMM]

{Source Code of PRAM-reader}

{PRAM-Reader is developed by}
{  Matthias Wuttke}
{  Hilterweg 14}
{  33803 Steinhagen}
{  GERMANY}
{  Internet: [e-mail] }

{ You may use this code and pieces of it freely if }
{ A) you send me a copy of your program }
{ B) you writes my name in your "About..."-box }

{ If you find any errors, please don't give out any versions, instead of doing this, report }
{ me the error and I will fix it. It's important not to have much different versions. }

{ Compiled with THINK Pascal 4.0.2. To use it with MPW Pascal, insert in the Initialize-Procedure at the end of this file }
{ calls to Toolbox routines to init the different managers. }

PROGRAM PRAMReader;
    CONST
        creator = 'PRRD';            { Creator of the application and its files }
        filetype = 'PRam';            { Type of PRAM-Content files }

{ Dialog-IDs }
        rAboutDialog = 128;
        rMainWindow = 129;

{ Menus }
        rMenuBar = 128;

        mApple = 128;
        mFile = 129;
        mEdit = 130;

{ Apple-Menu }
        iAbout = 1;

{ File-Menu }
        iReadPRAM = 1;
        iWritePRAM = 2;
        iQuit = 4;

{ Edit-Menu }
        iUndo = 1;
        iCut = 3;
        iCopy = 4;
        iPaste = 5;
        iClear = 6;

{ PRAM information }
        oldPRAMSize = 20;        { size of the "old" PRAM (see IM: OS Utils) }
        extPRAMSize = 256;    { size of the extended PRAM ("xPRAM") }

{ Traps for reading and writing the xPRAM *undocumented* }
        _ReadXPRam = $A051;
        _WriteXPRam = $A052;

{ Offsets of the two blocks we write into the xPRAM }
        parm1Off = 104;
        parm1Len = 12;

        parm2Off = 116;
        parm2Len = 138;

    TYPE
        UInt = Integer;        { declared as -32767..32768, but really 0..65535 }

        PRamSettings = RECORD        { this record is stored in PRAM-content files }
                PRam: SysParmType;        { "old" PRAM (see IM: OS Utils) }

                XPRam: PACKED RECORD        { the extended PRAM }
                        CASE Integer OF
                            0: (
                                    body: PACKED ARRAY[0..255] OF Char;        { raw data of xPRAM }
                            );
                            1: (
                                    layout: PACKED RECORD
{ clock settings, etc. }
                                            dummy1: PACKED ARRAY[0..51] OF UInt;         { +     0 }
{ the following two do we write. For a xPRAM-map mail me. }
                                            parm1: PACKED ARRAY[0..5] OF UInt;            { + 104 }
                                            parm2: PACKED ARRAY[0..68] OF UInt;        { + 116 }
{ unused, can't be written by _WriteXPRam because of a bug  in this trap }
                                            dummy2: UInt;                                            { + 254 }
                                        END;                                                        { + 256 }
                            );
                    END;
            END;
        PRamSettingsPtr = ^PRamSettings;

    VAR
        gEvent: EventRecord;
        gGotEvent, gQuit: boolean;
        mainDialog: DialogPtr;


{ ****** READING AND WRITING FROM/TO THE (x)PRAM ****** }


    PROCEDURE ReadXPRam (where: Ptr; size: Integer);        { reads size bytes of the xPRAM to where }
    INLINE
        $4280,    { CLR.L D0 }
        $301F,     { MOVE.W (A7)+, D0 }
        $4840,     { SWAP D0 }
        $205F,     { MOVEA.L (A7)+, A0 }
        _ReadXPRam;

    PROCEDURE WriteXPRam (where: Ptr; offset: Integer; size: Integer);
{ writes size bytes from where to the xPRAM beginning with offset }
    INLINE
        $201F,     { MOVE.L (A7)+, D0 }
        $205F,     { MOVEA.L (A7)+, A0 }
        _WriteXPRam;

    FUNCTION ReadPRamSettingsFromFile (refNum: Integer; VAR settings: PRamSettingsPtr): OSErr;
{ reads a PRamSettingsPtr from a PRAM-content file. settings is allocated. }
        VAR
            len: LongInt;
    BEGIN
        len := oldPRamSize + extPRamSize;        { size of block to read }
        Ptr(settings) := NewPtrClear(len);
        IF settings = NIL THEN
            ReadPRamSettingsFromFile := memFullErr
        ELSE
            ReadPRamSettingsFromFile := FSRead(refNum, len, Ptr(settings));        { read block }
    END;

    FUNCTION WritePRamSettingsToFile (refNum: Integer; settings: PRamSettingsPtr): OSErr;
{ writes a PRamSettingsPtr to a PRAM-content file. "settings" has to be valid}
        VAR
            len: LongInt;
    BEGIN
        len := oldPRamSize + extPRamSize;
        WritePRamSettingsToFile := FSWrite(refNum, len, Ptr(settings));
    END;

    FUNCTION GetPRamSettings (VAR p: PRamSettingsPtr): OSErr;
{ creates a new PRamSettingsPtr and fills it with the current content of the PRAM and the xPRAM }
    BEGIN
        Ptr(p) := NewPtrClear(oldPRAMSize + extPRAMSize);        { allocate memory }
        IF p <> NIL THEN
            BEGIN
                p^.PRam := GetSysPPtr^;        { copy "old" PRAM (see IM: OS Utils) }
                IF p^.PRam.valid <> $A8 THEN        { PRAM is only valid if first byte is $A8 }
                    GetPRamSettings := badFormat
                ELSE
                    BEGIN
                        ReadXPRam(@p^.xpram.body, extPRAMSize);        { reads the xPRAM }
                        GetPRamSettings := noErr;
                    END;
            END
        ELSE
            GetPRamSettings := memFullErr;
    END;

    PROCEDURE SetPRam (settings: PRamSettingsPtr);
{ sets the PRAM and the xPRAM to the settings specified in "settings". "settings" has to be allocated. }
        VAR
            err: OSErr;
    BEGIN
{ write "old" PRAM back (see IM: OS Utils) }
        GetSysPPtr^ := settings^.PRam;
        err := WriteParam;

{ write xPRAM back }
        WriteXPRam(@settings^.xpram.layout.parm1, parm1Off, parm1Len);
        WriteXPRam(@settings^.xpram.layout.parm2, parm2Off, parm2Len);
    END;


{ ****** APPLICATION EVENT HANDLING CODE ******* }

    PROCEDURE DoError (i: Integer);
{ displays an alert with the error message with the index i }
        VAR
            str: Str255;
            itemHit: Integer;
    BEGIN
        GetIndString(str, 128, i);
        ParamText(str, '', '', '');
        itemHit := Alert(256, NIL);
    END;

    PROCEDURE DoReadPRAM;
{ reads out the PRAM and writes it to a disk file. }
        VAR
            r: SFReply;
            pt: Point;
            err: OSErr;
            refnum: Integer;
            p: PRamSettingsPtr;

        PROCEDURE Check (ind: Integer);    { checks if an error occured }
        BEGIN
            IF err <> noErr THEN
                BEGIN
                    IF refnum <> 0 THEN
                        err := FSClose(refnum);
                    IF p <> NIL THEN
                        DisposePtr(Ptr(p));
                    DoError(ind);
                    Exit(DoReadPRAM);
                END;
        END;

    BEGIN
{ asking for the file name (I know, I should use the new routines (FSp...)) }
        p := NIL;
        SetPt(pt, 90, 90);
        refnum := 0;
        SFPutFile(pt, 'File name for PRAM-dump:', 'PRAM-Content', NIL, r);
        IF NOT r.good THEN
            exit(DoReadPRAM);

{ creating the file }
        err := FSDelete(r.fName, r.vRefNum);
        err := Create(r.fName, r.vRefNum, creator, filetype);
        Check(4);

{ opening it }
        err := FSOpen(r.fName, r.vRefNum, refnum);
        Check(4);

{ get a new PRamSettingsPtr }
        err := GetPRamSettings(p);
        IF err = badFormat THEN
            Check(2)
        ELSE IF err = memFullErr THEN
            Check(6);
        Check(4);


{ write it to a file }
        err := WritePRamSettingsToFile(refNum, p);
        Check(4);

{ clean up }
        err := FSClose(refnum);
        Check(4);

        DisposePtr(Ptr(p));
    END;

    PROCEDURE DoWritePRAM;
{ writes the content of a PRAM-content file to the PRAM }
        VAR
            pt: Point;
            tl: SFTypeList;
            r: SFReply;
            err: OSErr;
            refnum: Integer;
            len: LongInt;
            p: PRamSettingsPtr;

        PROCEDURE Check (ind: Integer);    { checks if an error occured }
        BEGIN
            IF err <> noErr THEN
                BEGIN
                    IF refnum <> 0 THEN
                        err := FSClose(refnum);
                    IF p <> NIL THEN
                        DisposePtr(Ptr(p));
                    DoError(ind);
                    Exit(DoWritePRAM);
                END;
        END;

    BEGIN
{ ask for file }
        p := NIL;
        SetPt(pt, 90, 90);
        tl[0] := filetype;

        SFGetFile(pt, 'Select PRAM-dump:', NIL, 1, tl, NIL, r);
        IF NOT r.good THEN
            Exit(DoWritePRAM);

{ open it }
        err := FSOpen(r.fName, r.vRefnum, refnum);
        Check(3);

{ get its length }
        err := GetEOF(refnum, len);
        Check(3);
        IF len = 20 THEN    { old version error }
            BEGIN
                err := -1;
                Check(5);
            END
        ELSE IF len <> oldPRamSize + extPRamSize THEN    { bad file error }
            BEGIN
                err := -1;
                Check(1);
            END;

{ rewrite it }
        err := ReadPRamSettingsFromFile(refNum, p);
        IF err = memFullErr THEN
            Check(6);    { not enough memory }
        Check(3);    { bad format (no $A8)? }

{ close file }
        err := FSClose(refnum);
        Check(3);

{ Are you sure... dialogue }
        IF Alert(257, NIL) = 2 THEN
            SetPRam(p);        { set the PRAM to its old content }

{ clean up }
        DisposePtr(Ptr(p));
    END;

    PROCEDURE DoAbout;
{ displays About...-dialogue }
        VAR
            itemHit: INTEGER;
            theDialog: DialogPtr;
    BEGIN
        theDialog := GetNewDialog(rAboutDialog, NIL, WindowPtr(-1));
        REPEAT
            ModalDialog(NIL, itemHit)
        UNTIL (itemHit = 1);
        DisposeDialog(theDialog);
    END;

    PROCEDURE DoAppleMenu (menuItem: INTEGER);
        VAR
            daRefNum: INTEGER;
            daName: Str255;
    BEGIN
        CASE menuItem OF
            iAbout:
                DoAbout;
            OTHERWISE
                BEGIN
                    GetItem(GetMHandle(mApple), menuItem, daName);
                    daRefNum := OpenDeskAcc(daName);
                END;
        END;
    END;

    FUNCTION IsDAWindow (theWindow: WindowPtr): INTEGER;
        VAR
            daRefNum: INTEGER;
    BEGIN
        daRefNum := WindowPeek(theWindow)^.windowKind;
        IF daRefNum < 0 THEN
            IsDAWindow := daRefNum
        ELSE
            IsDAWindow := 0;
    END;

    PROCEDURE DoClose;
        VAR
            theWindow: WindowPtr;
            daRefNum: Integer;
    BEGIN
        theWindow := FrontWindow;
        daRefNum := IsDAWindow(theWindow);
        IF daRefNum < 0 THEN
            BEGIN
                CloseDeskAcc(daRefNum);
                Exit(DoClose);
            END;
        IF theWindow = mainDialog THEN
            BEGIN
                DisposeDialog(mainDialog);
                gQuit := true;
            END
        ELSE
            DisposeWindow(theWindow);    { unknown window }
    END;

    PROCEDURE DoQuit;
    BEGIN
        gQuit := true;
        WHILE FrontWindow <> NIL DO
            DoClose;
    END;

    PROCEDURE DoFileMenu (menuItem: INTEGER);
    BEGIN
        CASE menuItem OF
            iReadPRAM:
                DoReadPRAM;
            iWritePRAM:
                DoWritePRAM;
            iQuit:
                DoQuit;
            OTHERWISE
                ;
        END;
    END;

    PROCEDURE DoMenuCommand (choice: LONGINT);
        VAR
            menuID, menuItem: INTEGER;
    BEGIN
        menuID := HiWord(choice);
        menuItem := LoWord(choice);
        CASE menuID OF
            mApple:
                DoAppleMenu(menuItem);
            mFile:
                DoFileMenu(menuItem);
            mEdit:
                IF NOT SystemEdit(menuItem - 1) THEN
                    SysBeep(1);
        END;
        HiliteMenu(0);
    END;

    PROCEDURE AdjustMenus;
        VAR
            theMenu: MenuHandle;
            i: Integer;
    BEGIN
        theMenu := GetMHandle(mEdit);
        IF ISDaWindow(FrontWindow) < 0 THEN    { enable all items if DA in front }
            FOR i := 0 TO iClear DO
                EnableItem(theMenu, i)
        ELSE                                            { else disable all }
            FOR i := 0 TO iClear DO
                DisableItem(theMenu, i);
    END;

    PROCEDURE MakeMenus;
        VAR
            menuBar: Handle;
    BEGIN
        menuBar := GetNewMBar(rMenuBar);
        SetMenuBar(menuBar);
        DisposHandle(menuBar);
        AddResMenu(GetMHandle(mApple), 'DRVR');
        DrawMenuBar;
    END;

    FUNCTION GetItemRect (d: DialogPtr; i: Integer): Rect;
{ returns the rectangle of item i of dialog d }
        VAR
            iKind: Integer;
            iHandle: Handle;
            iRect: Rect;
    BEGIN
        GetDItem(d, i, iKind, iHandle, iRect);
        GetItemRect := iRect;
    END;

    PROCEDURE DoContentClick (theWindow: WindowPtr);
{ checks if user hit button }
        VAR
            locMouse: Point;
            i, itemHit: Integer;
            r: Rect;

    BEGIN
        IF theWindow <> FrontWindow THEN
            BEGIN
                SelectWindow(theWindow);
                Exit(DoContentClick);
            END;

        SetPort(theWindow);
        locMouse := gEvent.where;
        GlobalToLocal(locMouse);
        IF theWindow <> mainDialog THEN
            Exit(DoContentClick);

        itemHit := -1;
        FOR i := 1 TO 4 DO
            IF PtInRect(locMouse, GetItemRect(mainDialog, i)) THEN
                itemHit := i;

        CASE itemHit OF
            1:
                DoReadPRAM;
            2:
                DoWritePRAM;
            3:
                DoAbout;
            4:
                DoQuit;
            -1:
                SysBeep(1);    { don't hit a button }
        END;
    END;

    PROCEDURE DoDragWindow (theWindow: WindowPtr);
    BEGIN
        IF theWindow <> FrontWindow THEN
            SelectWindow(theWindow);
        SetPort(theWindow);
        DragWindow(theWindow, gEvent.where, screenBits.bounds);
    END;

    PROCEDURE DoCloseWindow (theWindow: WindowPtr);
    BEGIN
        IF TrackGoAway(theWindow, gEvent.where) THEN
            DoClose;
    END;

    PROCEDURE DoMouseDown;
        VAR
            part: INTEGER;
            theWindow: WindowPtr;
    BEGIN
        part := FindWindow(gEvent.where, theWindow);
        CASE part OF
            inSysWindow:
                SystemClick(gEvent, theWindow);
            inContent:
                DoContentClick(theWindow);
            inDrag:
                DoDragWindow(theWindow);
            inGoAway:
                DoCloseWindow(theWindow);
            inMenuBar:
                BEGIN
                    AdjustMenus;
                    DoMenuCommand(MenuSelect(gEvent.where));
                END;
        END;
    END;

    PROCEDURE DoKeyDown;
        VAR
            key: char;
    BEGIN
        IF BitAnd(gEvent.modifiers, cmdKey) = cmdKey THEN
            BEGIN
                key := char(BitAnd(gEvent.message, charCodeMask));
                AdjustMenus;
                DoMenuCommand(MenuKey(key));
            END;
    END;

    PROCEDURE DoUpdate;
        VAR
            theWindow: WindowPtr;
    BEGIN
        theWindow := WindowPtr(gEvent.message);
        BeginUpdate(theWindow);
        SetPort(theWindow);
        EraseRect(theWindow^.portRect);
        IF theWindow = mainDialog THEN
            BEGIN
                DrawDialog(mainDialog);    { the Dialog Manager does the work for us }
            END;
        EndUpdate(theWindow);
    END;

    PROCEDURE DoActivate;
    BEGIN
{ only one window in this app, if switching, it is hided }
    END;

    PROCEDURE DoOsEvt;
    BEGIN
        IF BAnd(BRotL(gEvent.message, 8), $FF) = suspendResumeMessage THEN
            IF BAnd(gEvent.message, resumeFlag) <> 0 THEN
                BEGIN
                    ShowWindow(mainDialog);        { show window if switching to PRAM-Reader }
                END
            ELSE
                BEGIN
                    HideWindow(mainDialog);        { hide window if switching to the background }
                END;
    END;

    PROCEDURE DoEvent;
    BEGIN
        CASE gEvent.what OF
            mouseDown:
                DoMouseDown;
            keyDown:
                DoKeyDown;
            autoKey:
                DoKeyDown;
            updateEvt:
                DoUpdate;
            activateEvt:
                DoActivate;
            osEvt:
                DoOsEvt;
        END;
    END;

{ ****** INTIALISATION OF PRAM-READER ****** }

    PROCEDURE OpenMainWindow;
        VAR
            r: Rect;
            pt: Point;
    BEGIN
        mainDialog := GetNewDialog(rMainWindow, NIL, WindowPtr(-1));
    END;

    PROCEDURE Initialize;
    BEGIN
{ don't need to init toolbox because THINK Pascal does this for us }
        SetCursor(arrow);
        gQuit := false;
        MakeMenus;
        OpenMainWindow;
    END;

{ ****** MAIN EVENT LOOP ****** }
BEGIN
    Initialize;
    WHILE NOT gQuit DO
        BEGIN
            gGotEvent := WaitNextEvent(everyEvent, gEvent, 15, NIL);
            IF gGotEvent THEN
                DoEvent;
        END;
END.